home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 3 / BBS in a box - Trilogy III.iso / Files / Prog / L-M / MacOberon 4.0 / MacOberon™ 4.0 Folder / TickCounter.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1993-10-25  |  3.8 KB  |  94 lines  |  [.Ob./.Ob5]

  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. MODULE TickCounter;    (* Michael Franz, 10.10.91 / 25.10.93 *)
  4.     Installs a Task that will update a tick count which is displayed centered
  5.     in a viewer. Oberon Tasks keep running when another application is
  6.     brought in front of MacOberon, but are activated less often.
  7.         The tick count may be exported to the caret position by the usual
  8.     CopyOver control_option mouse key combination.
  9.     Position the Star Marker in this viewer (Enter on Keypad)
  10.             Compiler.Compile *
  11.             TickCounter.Open
  12. IMPORT
  13.     SYSTEM, Display, Fonts, Oberon, Texts, TextFrames, Viewers, MenuViewers, Input;
  14. CONST
  15.     Font="Helvetica48.Scn.Fnt";
  16.     TickMsg=RECORD (Display.FrameMsg) END;
  17.     Frame=POINTER TO FrameDesc;
  18.     FrameDesc=RECORD (Display.FrameDesc) END;
  19.     W: Texts.Writer;
  20.     ticks: LONGINT; countTask: Oberon.Task;
  21.     fnt: Fonts.Font; x0, y0, w0, h0, dx0: INTEGER; pat0: Display.Pattern;
  22.     PROCEDURE* Tick;    (* Installed as an Oberon Task *)
  23.         VAR t: LONGINT; M: TickMsg;
  24.     BEGIN    SYSTEM.GET(16AH, t);
  25.         IF    t#ticks    THEN    ticks:=t; Viewers.Broadcast(M)    END
  26.     END Tick;
  27.     PROCEDURE UpdateCounter(F: Frame);    (* Update Tick Count in Frame F *)
  28.         VAR ch: CHAR; n: LONGINT; a: ARRAY 10 OF INTEGER; i, X, Y, dx, x, y, w, h: INTEGER; pat: Display.Pattern;
  29.     BEGIN
  30.         IF    F.H > fnt.height    THEN    i:=0; n:=ticks;
  31.             REPEAT    a[i]:=SHORT(n MOD 10); n:=n DIV 10; INC(i)    UNTIL    n=0;
  32.             X:=F.X+(F.W-i*dx0) DIV 2; Y:=F.Y+(F.H-fnt.height) DIV 2;
  33.             REPEAT    DEC(i); ch:=CHR(a[i]+ORD("0"));
  34.                 Display.GetChar(fnt.raster, ch, dx, x, y, w, h, pat);
  35.                 Display.CopyPattern(Display.white, pat, X+x, Y+y, Display.replace); INC(X, dx0)
  36.             UNTIL    i=0;
  37.         END
  38.     END UpdateCounter;
  39.     PROCEDURE Export;    (* Copy Counter to Caret *)
  40.         VAR M: Oberon.CopyOverMsg;
  41.     BEGIN    Texts.WriteInt(W, ticks, 8); M.text:=TextFrames.Text(""); Texts.Append(M.text, W.buf);
  42.         M.beg:=0; M.end:=M.text.len; Oberon.FocusViewer.handle(Oberon.FocusViewer, M)
  43.     END Export;
  44.     PROCEDURE Handle*(F: Display.Frame; VAR M: Display.FrameMsg);
  45.         VAR keysum: SET; F1: Frame;
  46.     BEGIN
  47.         WITH    F: Frame    DO
  48.             IF    M IS TickMsg    THEN    UpdateCounter(F)
  49.             ELSIF    M IS Oberon.InputMsg    THEN
  50.                 WITH    M: Oberon.InputMsg    DO
  51.                     IF    M.id=Oberon.track    THEN    keysum:=M.keys; Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, M.X, M.Y);
  52.                         WHILE    M.keys # {}    DO    Input.Mouse(M.keys, M.X, M.Y); keysum:=keysum+M.keys;
  53.                             Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, M.X, M.Y)
  54.                         END;
  55.                         IF    keysum={0, 1}    THEN    Export    END
  56.                     END
  57.                 END
  58.             ELSIF    M IS Oberon.ControlMsg    THEN
  59.                 WITH    M: Oberon.ControlMsg    DO
  60.                     IF    M.id=Oberon.mark    THEN    Oberon.DrawCursor(Oberon.Pointer, Oberon.Star, M.X, M.Y)    END
  61.                 END
  62.             ELSIF    M IS Oberon.CopyMsg    THEN
  63.                 WITH    M: Oberon.CopyMsg    DO    NEW(F1); F1^:=F^; M.F:=F1    END
  64.             ELSIF    M IS MenuViewers.ModifyMsg    THEN
  65.                 WITH    M: MenuViewers.ModifyMsg    DO    F.H:=M.H; F.Y:=M.Y;
  66.                     IF    M.H > 0    THEN    Display.ReplConst(Display.black, F.X, F.Y, F.W, F.H, Display.replace); UpdateCounter(F)    END
  67.                 END
  68.             END
  69.         END
  70.     END Handle;
  71.     PROCEDURE NewCountFrame(): Frame;
  72.         VAR F: Frame;
  73.     BEGIN    NEW(F); F.handle:=Handle; RETURN F
  74.     END NewCountFrame;
  75.     PROCEDURE NewCountTask(VAR T: Oberon.Task);
  76.     BEGIN    NEW(T); T.safe:=FALSE; T.handle:=Tick; Oberon.Install(T)
  77.     END NewCountTask;
  78.     PROCEDURE Open*;
  79.         VAR X, Y: INTEGER; V: Viewers.Viewer;
  80.     BEGIN
  81.         IF    countTask=NIL    THEN    NewCountTask(countTask)    END;
  82.         Oberon.AllocateSystemViewer(Oberon.SystemTrack(0), X, Y);
  83.         V:=MenuViewers.New(
  84.             TextFrames.NewMenu("TickCounter", "System.Close System.Copy System.Grow TickCounter.Stop"),
  85.             NewCountFrame(), TextFrames.menuH, X, Y)
  86.     END Open;
  87.     PROCEDURE Stop*;
  88.     BEGIN    Oberon.Remove(countTask); countTask:=NIL
  89.     END Stop;
  90. BEGIN    Texts.OpenWriter(W);
  91.     fnt:=Fonts.This(Font); Display.GetChar(fnt.raster, "0", dx0, x0, y0, w0, h0, pat0);
  92.     NewCountTask(countTask)
  93. END TickCounter.
  94.